home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol017 / xref.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-01-11  |  9.1 KB  |  321 lines
  1. (******************************************************
  2. *
  3. *    Donated to the Pascal/Z Users Group by Ithaca
  4. *  Intersystems, Dec 1980.
  5. ******************************************************)
  6.  
  7. Program  xref; {$i+,e+,l- }
  8. { This is a quick and dirty program to do Pascal cross reference listings }
  9. { without regard to Pascal scoping rules. It has a minimum of comments and}
  10. { was intended for internal use only                      }
  11. { This program may die terribly if your program is not of correct Pascal  }
  12. { syntax. Each symbol which only occurs once is marked with an '*'.      }
  13. const tab = 9;
  14.       cr  = 13;
  15.       lf  = 10;
  16.       blanks = '        ';
  17.       symlen = 8;
  18.       tabsize = 750;
  19.       listsize = 10;
  20.  
  21. type  symbol = array[ 1..symlen ] of char;
  22.       xreflist = record
  23.              nextlist: ^xreflist;
  24.              xreflines: array[ 1..listsize ] of integer;
  25.          end;
  26.       $string255 = string 255;
  27.       $string0     = string 0;
  28.       byte = 0..255;
  29.  
  30. var  i, j, linepos, symcnt: integer;
  31.     caps,
  32.     good_ctrl,    { set of acceptable control characters }
  33.     stop, stoppnum: set of char;
  34.     tab_index: integer;
  35.     entry: ^xreflist;
  36.  
  37.     { save all of the symbols in alphabetical order }
  38.     symbols: array[ 1..tabsize ] of symbol;
  39.  
  40.     { for each symbol there is a list of references, this table has a }
  41.     { pointer to the start of the list                      }
  42.     xreftable: array[ 1..tabsize ] of ^xreflist;
  43.  
  44.     { count the number of references for the corresponding symbol }
  45.     xctr:   array[ 1..tabsize ] of integer;
  46.  
  47.     { it is important to know the line number in order to xref }
  48.     linectr: integer;
  49.  
  50.     firstchar: boolean; { is this the first character on this line }
  51.  
  52.     answer: char;
  53.  
  54.     { used in reading the Pascal program }
  55.     already_read: boolean;
  56.     one_ahead,
  57.     curch: char;
  58.  
  59.     { the latest symbol extracted from the Pascal program }
  60.     current_symbol: array[ 1..symlen ] of char;
  61.  
  62.     { input/output files }
  63.     pasprog,
  64.     xrefout: text;
  65.  
  66.     { for constructing file names }
  67.     filnam: string 50;
  68.  
  69. { do a binary search for the current identifier, if found return the index }
  70. { and set the function return value to TRUE.                   }
  71. { if not found set index to correct insertion point.               }
  72. function  bsearch( var index: integer ): boolean;
  73. var i,j,k: integer;
  74.     done: boolean;
  75. begin
  76.     i := 1;
  77.     j := symcnt;
  78.     done := false;
  79.     repeat
  80.     k := (j - i + 1) div 2 + i;
  81.     if current_symbol < symbols[ k ] then j := k - 1
  82.     else if current_symbol > symbols[ k ] then i := k + 1
  83.     else done := true
  84.     until done or (i > j );
  85.     index := k;
  86.     if not done and (symbols[k] < current_symbol) then index := k + 1;
  87.     bsearch := done
  88. end;
  89.  
  90. { get the next character }
  91. { convert ugly control control characters to spaces and convert upper case }
  92. { to lower case                                }
  93. procedure nextch;
  94. begin
  95.     if firstchar then linectr := linectr + 1;
  96.     firstchar := eoln( pasprog );
  97.     if already_read then begin
  98.     curch := one_ahead;
  99.     already_read := false
  100.     end
  101.     else if not eof( pasprog ) then begin
  102.     read( pasprog, curch );
  103.     { convert ugly control chars to spaces }
  104.     if (curch < ' ') and not(curch in good_ctrl) then curch := ' ';
  105.     { convert upper to lower case }
  106.     if curch in caps then curch := chr( ord( curch ) + 32 );
  107.     end;
  108. end;
  109.  
  110. { return the look-a-head character from the input stream }
  111. function lookahead: char;
  112. var temp: char;
  113. begin
  114.     if already_read then lookahead := one_ahead
  115.     else begin
  116.     temp := curch;
  117.     nextch;
  118.     one_ahead := curch;
  119.     lookahead := curch;
  120.     already_read := true;
  121.     curch := temp
  122.     end;
  123. end;
  124.  
  125. { find the next symbol skipping over quoted strings, comments, numbers and }
  126. { special symbols (i.e. <> )                           }
  127. procedure  parse;
  128. var i: byte;
  129. begin
  130.     { skip characters until we get one that can start an identifier or }
  131.     { we hit the end of the file                       }
  132.     repeat
  133.     nextch;
  134.     if curch = '''' then begin
  135.         repeat
  136.         nextch
  137.         until curch = ''''
  138.     end
  139.     else if ((curch='(') and (lookahead='*')) or
  140.         (curch = '{')  then repeat
  141.         repeat
  142.         nextch
  143.         until (curch = '*') or (curch='}')
  144.     until (lookahead = ')') or (curch='}');
  145.     until not (curch in stoppnum) or eof( pasprog );
  146.     i := 0;
  147.     current_symbol := blanks;
  148.     { read the identifier into current_symbol, ignoring characters which }
  149.     { exceed the maximum symbol length                     }
  150.     repeat
  151.     i := i + 1;
  152.     if i <= symlen then current_symbol[ i ] := curch;
  153.     nextch;
  154.     until curch in stop;
  155. end;
  156.  
  157. { add a cross reference entry to the table }
  158. procedure add_xref( sym_index, ref_line: integer );
  159. var ptrnum: integer;
  160. begin
  161.     entry := xreftable[ sym_index ];
  162.     ptrnum := xctr[sym_index] mod listsize + 1;
  163.     xctr[sym_index] := xctr[sym_index]+1;
  164.     while (entry^.nextlist <> nil) do entry := entry^.nextlist;
  165.     if ptrnum = 1 then
  166.     begin
  167.         new( entry^.nextlist );
  168.         entry := entry^.nextlist;
  169.         entry^.nextlist := nil
  170.     end;
  171.     entry^.xreflines[ptrnum] := ref_line
  172. end;
  173.  
  174.  
  175. { add the current symbol to the symbol table at position 'index' }
  176. procedure  add_symbol( index: integer );
  177. var i: integer;
  178. begin
  179.     symcnt := symcnt + 1;
  180.     for i := symcnt downto index+1 do begin
  181.     symbols[ i ] := symbols[ i-1 ];
  182.     xctr[ i ] := xctr[ i-1 ];
  183.     xreftable[ i ] := xreftable[ i-1 ];
  184.     end;
  185.     new( entry );
  186.     xctr[index] := 1;
  187.     xreftable[index] := entry;
  188.     entry^.nextlist := nil;
  189.     entry^.xreflines[1] := linectr;
  190.     symbols[index] := current_symbol
  191. end;
  192.  
  193. { add an initial entry to the symbol table....these entries are the }
  194. { Pascal/Z reserved words.                        }
  195. procedure init( res: symbol );
  196. var i: integer;
  197.     junk: boolean;
  198. begin
  199.     current_symbol := res;
  200.     junk := bsearch( i );
  201.     add_symbol( i )
  202. end;
  203.  
  204. function  index( x, y: $string255 ): integer; external;
  205. procedure  setlength( var x: $string0; y: integer ); external;
  206.  
  207. {
  208.  start of program
  209. }
  210. begin
  211.     writeln( 'XREF -- version 1a' );
  212.     already_read := false;
  213.     good_ctrl := [ chr( tab ), chr( cr ), chr( lf ) ];
  214.     stop := [ chr( tab ),' ',':',',','+','-','/','*','(',')','=','.','>',
  215.           '<','{','}','[',']', '''', '^', ';'  ];
  216.     stoppnum := stop + [ '0'..'9' ];
  217.     caps := [ 'A'..'Z' ];
  218.     repeat
  219.     if eoln( 0 ) then write( 'File name -- ' );
  220.     readln( filnam );
  221.     linepos := index( filnam, '.' );
  222.     if linepos <> 0 then setlength( filnam, linepos-1 );
  223.     append( filnam, '.pas' );
  224.     reset( filnam, pasprog );
  225.     until not eof( pasprog );
  226.     for i := 1 to tabsize do symbols[ i ] := '}       ';
  227.     symcnt := 0;
  228.     linectr := 0;
  229.     firstchar := true;
  230.     init( 'and     ' );
  231.     init( 'array   ' );
  232.     init( 'begin   ' );
  233.     init( 'case    ' );
  234.     init( 'const   ' );
  235.     init( 'div     ' );
  236.     init( 'do      ' );
  237.     init( 'downto  ' );
  238.     init( 'else    ' );
  239.     init( 'end     ' );
  240.     init( 'external' );
  241.     init( 'file    ' );
  242.     init( 'for     ' );
  243.     init( 'forward ' );
  244.     init( 'function' );
  245.     init( 'goto    ' );
  246.     init( 'if      ' );
  247.     init( 'in      ' );
  248.     init( 'label   ' );
  249.     init( 'mod     ' );
  250.     init( 'nil     ' );
  251.     init( 'not     ' );
  252.     init( 'of      ' );
  253.     init( 'or      ' );
  254.     init( 'packed  ' );
  255.     init( 'procedur' );
  256.     init( 'program ' );
  257.     init( 'record  ' );
  258.     init( 'repeat  ' );
  259.     init( 'set     ' );
  260.     init( 'string  ' );
  261.     init( 'then    ' );
  262.     init( 'to      ' );
  263.     init( 'type    ' );
  264.     init( 'until   ' );
  265.     init( 'var     ' );
  266.     init( 'while   ' );
  267.     init( 'with    ' );
  268.     while not eof( pasprog ) do
  269.     begin
  270.         parse;
  271.         if current_symbol <> blanks then begin
  272.         if bsearch( tab_index ) then add_xref( tab_index, linectr )
  273.         else add_symbol( tab_index )
  274.         end;
  275.     end;
  276.     linepos := index( filnam, '.' );
  277.     setlength( filnam, linepos-1 );
  278.     append( filnam, '.xrf' );
  279.     rewrite( filnam, xrefout );
  280.     writeln( xrefout, 'Total identifiers = ', symcnt-38:1 );
  281.     for j := 1 to symcnt do
  282.     if xreftable[ j ]^.xreflines[ 1 ] <> 0 then begin
  283.         writeln( xrefout, ' ' );
  284.         write( xrefout, symbols[ j ], '  ' );
  285.         entry := xreftable[ j ];
  286.         for i := 1 to xctr[ j ] do
  287.         begin
  288.             write( xrefout,
  289.                entry^.xreflines[(i-1) mod listsize + 1]:6 );
  290.             if (i mod 10 = 0) and (xctr[ j ] > i ) then begin
  291.             writeln( xrefout );
  292.             write(     xrefout, '          ' )
  293.             end;
  294.             if i mod listsize = 0 then    entry := entry^.nextlist;
  295.         end;
  296.         if xctr[ j ] = 1 then write( xrefout, '*' );
  297.     end;
  298.     write( 'Include reserved words? ' ); readln( answer );
  299.     if answer in [ 'Y', 'y' ] then begin
  300.     writeln( xrefout );
  301.     writeln( xrefout );
  302.     writeln( xrefout, 'Reserved words:' );
  303.     for j := 1 to symcnt do
  304.         if xreftable[ j ]^.xreflines[ 1 ] = 0 then begin
  305.         writeln( xrefout, ' ' );
  306.         write( xrefout, symbols[ j ], '  ' );
  307.         entry := xreftable[ j ];
  308.         for i := 2 to xctr[ j ] do
  309.             begin
  310.             write( xrefout,
  311.                 entry^.xreflines[(i-1) mod listsize + 1]:6 );
  312.             if (i mod 10 = 0) and (xctr[ j ] > i ) then begin
  313.                 writeln( xrefout );
  314.                 write(     xrefout, '          ' )
  315.             end;
  316.             if i mod listsize = 0 then entry := entry^.nextlist;
  317.             end;
  318.         end;
  319.      end;
  320. end.
  321.